Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/security/wuser/username.frm

Text File | 1995-10-11 | 9KB | 248 lines

VERSION 2.00
Begin Form ChG_UserName
   BorderStyle     =   1  'Fixed Single
   Caption         =   "'Secret' Windows Access"
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Height          =   2460
   Icon            =   USERNAME.FRX:0000
   Left            =   1050
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2055
   ScaleWidth      =   4275
   Top             =   1395
   Width           =   4395
   Begin CommandButton cmd
      Caption         =   "&OK"
      Height          =   315
      Left            =   3420
      TabIndex        =   6
      Top             =   1560
      Width           =   675
   End
   Begin TextBox Text
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8,25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   285
      HideSelection   =   0   'False
      Index           =   2
      Left            =   2280
      MousePointer    =   1  'Arrow
      TabIndex        =   2
      Top             =   1575
      Width           =   915
   End
   Begin TextBox Text
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8,25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   285
      HideSelection   =   0   'False
      Index           =   1
      Left            =   180
      MousePointer    =   1  'Arrow
      TabIndex        =   1
      Top             =   1080
      Width           =   3915
   End
   Begin TextBox Text
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8,25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   285
      HideSelection   =   0   'False
      Index           =   0
      Left            =   180
      MousePointer    =   1  'Arrow
      TabIndex        =   0
      Top             =   420
      Width           =   3915
   End
   Begin Label Label1
      Caption         =   "&True Windows Version:"
      Height          =   195
      Index           =   2
      Left            =   180
      TabIndex        =   5
      Top             =   1620
      Width           =   1980
   End
   Begin Label Label1
      Caption         =   "&Company Name:"
      Height          =   195
      Index           =   1
      Left            =   180
      TabIndex        =   4
      Top             =   840
      Width           =   1380
   End
   Begin Label Label1
      Caption         =   "&User Name:"
      Height          =   195
      Index           =   0
      Left            =   180
      TabIndex        =   3
      Top             =   180
      Width           =   1005
   End
End
'                                                         '
'  *****************************************************  '
'  This example demonstrates how to access the UserName,  '
'      the CompanyName and the true Windows version.      '
'  *****************************************************  '
'                                                         '
'    For more details see USERNAME.HLP which should be    '
'     contained as well in this archive (WUSER.EXE).      '
'                                                         '
'     If you have further questions e-mail the author     '
'                directly via CompuServe.                 '
'                                                         '
'                  Christian Germelmann                   '
'                     Am Glaskopf 26                      '
'                   35039 Marburg/Lahn                    '
'                        Germany                          '
'                  Phone [phone]                   '
'                 CompuServe 100520,2644                  '
'                                                         '
'  Disclaimer: the author will not be responsible for any '
'              misuse of this sample code !               '
'                                                         '
Option Explicit

Dim retInt%     ' holds an Integer variable '
Dim retLng&     ' holds a Long variable     '

' *****************************************************************
' * The declarations for disabling the editing of the text boxes: *
' *****************************************************************

Declare Function SendMessage& Lib "USER" Alias "#111" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
Const WM_USER& = &H400
Const EM_SETREADONLY& = (WM_USER + 31)


' ************************************************
' * The API declarations to the 'secret access': *
' ************************************************

Declare Function GetModuleHandle% Lib "KERNEL" Alias "#47" (ByVal lpModuleName$)
Declare Function LoadString% Lib "USER" Alias "#176" (ByVal hInstance%, ByVal wID%, ByVal lpBuffer As Any, ByVal nBufferMax%)

' --> Correct numbers for the Alias-declarations '
'     can e.g. be achived with the author's      '
'     program APIMAN.EXE.                        '

Sub cmd_Click ()

    Unload Me

End Sub

Function CompanyName$ ()

    CompanyName = GetUserString(515)

End Function

Sub Form_Load ()

    ' *****************************************
    ' Fill the text boxes with the desired data
    ' *****************************************
    Text(0) = UserName()
    Text(1) = CompanyName()
    Text(2) = TrueWinVer()

    ' *********************************
    ' Make the text boxes 'untouchable'
    ' *********************************
    retLng = SendMessage(Text(0).hWnd, EM_SETREADONLY, True, 0)
    retLng = SendMessage(Text(1).hWnd, EM_SETREADONLY, True, 0)
    retLng = SendMessage(Text(2).hWnd, EM_SETREADONLY, True, 0)

    ' ************************
    ' Place the form on screen
    ' ************************
    Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2.5

    Show

End Sub

'                                                                 '
' This is the function that returns a string from the USER.EXE.   '
' To access other loaded (!) modules exchange "USER" against the  '
' other module's name and select a string number.                 '
'                                                                 '
' In the USER.EXE we e.g. find:                                   '
'   514  the UserName                                             '
'   515  the CompanyName                                          '
'   516  the true Windows version                                 '
'   518  the serial number                                        '
'                                                                 '
' and for multilingual purposes:                                  '
'    85  'Cancel'                                                 '
'    86  '&Abort'                                                 '
'    87  '&Retry'                                                 '
'    88  '&Ignore'                                                '
'    89  '&Yes'                                                   '
'    90  '&No'                                                    '
'    78  'Error'                                                  '
' --> All in the respective language of a country !               '
' --> Use them for international labeling !                       '
'                                                                 '
Function GetUserString$ (StringNumber%)

Dim ReturnedString$

    ' ********************************* '
    ' The maximum length of a string at '
    ' that location is 30 characters.   '
    ' So we preload only 30 spaces.     '
    ' ********************************* '
    ReturnedString = Space(30)
    retInt = LoadString(GetModuleHandle("USER"), StringNumber, ReturnedString, Len(ReturnedString))

    ' ********************************************************* '
    ' We actually do not need this now but when accessing other '
    ' strings for a mulilingual purpose we should keep it here. '
    ' ********************************************************* '
    ReturnedString = (Left$(ReturnedString, retInt))

GetUserString = Trim$(ReturnedString)

End Function

Sub Text_Change (Index As Integer)

    Text(Index).SelStart = 0
    Text(Index).SelLength = 30
    DoEvents

End Sub

Function TrueWinVer$ ()

    TrueWinVer = GetUserString(516)

End Function

Function UserName$ ()

    UserName = GetUserString(514)

End Function